When, Who, Why
Andriy Koval
Apr 23, 2020
This report discribes the visits to the pediatric urology clinin, answering the questions WHEN the visit occured (month_of_appointment), WHO saw the patient (provider), and WHY the patient came (reason_for_visit).
Environment
Packages that will be used in this analysis:
library(ggplot2) #For graphing
library(magrittr) #Pipes
library(dplyr) # for shorter function names. but still prefer dplyr:: stems
library(knitr) # dynamic documents
library(rmarkdown) # dynamic
library(kableExtra) # enhanced tables, see http://haozhu233.github.io/kableExtra/awesome_table_in_html.html
library(ggpubr)
# library(TabularManifest) # exploratory data analysis, see https://github.com/Melinae/TabularManifest
requireNamespace("knitr", quietly=TRUE)
requireNamespace("scales", quietly=TRUE) #For formating values in graphs
requireNamespace("RColorBrewer", quietly=TRUE)
requireNamespace("dplyr", quietly=TRUE)
requireNamespace("DT", quietly=TRUE) # for dynamic tables#Load any source files that contain/define functions, but that don't load any other types of variables
# into memory. Avoid side effects and don't pollute the global environment.
source("./scripts/common-functions.R") # used in multiple reports
source("./scripts/graphing/graph-presets.R") # fonts, colors, themes
source("./scripts/modeling/model-basic.R")
source("./scripts/graphing/graph-missing.R")varnames_varlabels <- c(
"patient_id" = "Patient Id"
,"male" = "Gender = Male"
,"reason_for_visit" = "Reason for Visit / Diagnosis"
,"provider" = "Service provider"
,"insurance" = "Insurance"
,"history_noshow" = "History of No-Show"
,"month_of_appointment" = "Month of Appoinment"
,"pm_appointment" = "Afternoon Appointment"
,"preferred_language" = "Preferred Language"
,"returned_to_care" = "Returned to Care"
,"letter_sent" = "Was letter sent?"
)
# positive Green, negative Orange
letter_sent_colors <- c(
"Letter sent" = "#66c2a5"
,"No letter sent" = "#fc8d62"
)
# positive Teal, negative Brown
returned_to_care_colors <- c(
"Returned to care"="#80CDC1"
,"No show"="#DFC27D"
)
# # positive Green, negative Purple
# colorsFill <- c("TRUE"="#A6DBA0" ,"FALSE"="#C2A5CF") # The colors for negative and positve values of factor loadings for ggplot
# colorFont <- c("TRUE"="#008837" ,"FALSE"="#7B3294") # The colors for negative and positve values of factor loadings for ggplot
#set default ggplot theme
ggplot2::theme_set(ggplot2::theme_bw())To better understand the data set, let us inspect quantitative properties of each variable
run_logistic <- function(d,p){
# d <- ds_modeling
# p <- predictors_00
#
# browser()
ls_out <- list()
eq_formula <- as.formula(paste0(outcome, paste(p, collapse = " + ") ) )
model <- stats::glm(
formula = eq_formula
# ,family = "binomial"
,family=binomial(link=logit)
,data = d %>%
select(-patient_id)
)
# create levels of predictors for which to generate predicted values
d_predicted <- d %>%
dplyr::select(p) %>%
dplyr::distinct()
# add model prediction
d_predicted <- d_predicted %>%
dplyr::mutate(
log_odds = predict(object = model, newdata = .)
,probability = plogis(log_odds)
# ,prob1 = predict.glm(object = model, newdata = .,type = "response")
)
ls_out[["equation"]] <- eq_formula
ls_out[["model"]] <- model
ls_out[["predicted"]] <- d_predicted
return(ls_out)
}
# How to use
# lsm00 <- ds_modeling %>% run_logistic(predictors_00)
# model <- lsm00$model
get_rsquared <- function(m){
cat("R-Squared, Proportion of Variance Explained = ",
scales::percent((1 - (summary(m)$deviance/summary(m)$null.deviance)),accuracy = .01)
, "\n")
}
get_model_fit <- function(m){
cat("MODEL FIT",
"\nChi-Square = ", with(m, null.deviance - deviance),
"\ndf = ", with(m, df.null - df.residual),
"\np-value = ", with(m, pchisq(null.deviance - deviance, df.null - df.residual, lower.tail = FALSE)),"\n"
)
}
# from source("./scripts/modeling/model-basic.R")
# basic_model_insource("./scripts/modeling/model-basic.R")fo()
# make_result_table()
make_facet_graph <- function(d, x_aes, fill_aes, facet_row=NULL, facet_col=NULL, smooth = NULL, y_aes = "n_patients"){
# d <- ds_modeling
# x_aes <- "month_of_appointment"
# fill_aes <- "letter_sent"
# facet_row <- "provider"
# facet_col <- "reason_for_visit"
# y_aes = "n_patients"
sample_size <- d %>% dplyr::count() %>% dplyr::pull()
d1 <- d %>%
dplyr::group_by(.dots = c(x_aes, fill_aes, facet_row, facet_col)) %>%
dplyr::summarize(
n_patients = dplyr::n()
) %>%
dplyr::ungroup() %>%
dplyr::mutate(
pct_patients = (n_patients / sample_size)*100
)
number_of_hues <- d1 %>% dplyr::distinct(!!ensym(fill_aes)) %>% nrow()
# g1 <- d1 %>%
# ggplot(aes(x = !!ensym(x_aes), y = !!ensym(y_aes), fill = !!ensym(fill_aes))) +
# geom_col()+
# theme(
# axis.text.x = element_text(angle = 90, vjust = .2)
# ,legend.position = "top"
# )
g1 <- d1 %>%
ggplot(
aes(
x = !!ensym(x_aes)
, y = !!ensym(y_aes)
, fill = !!ensym(fill_aes)
,group = !!ensym(fill_aes)
)
) +
geom_col( alpha = .2, color = "black")+
geom_point(shape =21, color = "black",size = 2 )+
geom_line(aes(color = !!ensym(fill_aes)))+
# scale_fill_manual(values = (RColorBrewer::brewer.pal(number_of_hues,"Dark2")[1:number_of_hues]))
# scale_color_manual(values = (RColorBrewer::brewer.pal(number_of_hues,"Dark2")[1:number_of_hues]))
theme(
axis.text.x = element_text(angle = 90, vjust = .2)
,legend.position = "top"
)
# g1
if(!is.null(facet_row) & !is.null(facet_col)){
facet_expr <- paste0( facet_row, " ~ ", facet_col)
}
if(is.null(facet_row) & !is.null(facet_col)){
facet_expr <- paste0( ". ~ ", facet_col)
}
if(!is.null(facet_row) & is.null(facet_col)){
facet_expr <- paste0( facet_row, " ~ .")
}
if( !is.null(facet_row) | !is.null(facet_col) ){
facet_formula <- enexpr(facet_expr)
g1 <- g1 +facet_grid(facet_formula)
}
g1
return(g1)
}
# How to use
# ds_modeling %>% make_facet_graph(
# x_aes = "month_of_appointment"
# ,fill_aes = "letter_sent"
# ,facet_row = "provider"
# ,facet_col = "reason_for_visit"
# )
# ds_modeling %>% make_facet_graph(
# x_aes = "month_of_appointment"
# ,fill_aes = "letter_sent"
# # ,facet_row = "provider"
# # ,facet_col = "reason_for_visit"
# )Provider by Reason
Two of the categories in reason_for_visit are poorly populated. We present these data once, but remove bladder and female gyn in subsequent graphs to improve visibility.
Insurance
Afternoon Appointment
Preferred Language
Gender = Male
History of No-Show
Was letter sent?
Returned to Care
session information
For the sake of documentation and reproducibility, the current report was rendered in the following environment. Click the line below to expand.
Environment
- Session info -------------------------------------------------------------------------------------------------------
setting value
version R version 3.6.3 (2020-02-29)
os Windows 10 x64
system x86_64, mingw32
ui RTerm
language (EN)
collate English_United States.1252
ctype English_United States.1252
tz America/New_York
date 2020-04-28
- Packages -----------------------------------------------------------------------------------------------------------
package * version date lib source
assertthat 0.2.1 2019-03-21 [1] CRAN (R 3.6.2)
backports 1.1.5 2019-10-02 [1] CRAN (R 3.6.1)
callr 3.4.3 2020-03-28 [1] CRAN (R 3.6.3)
cli 2.0.2 2020-02-28 [1] CRAN (R 3.6.3)
colorspace 1.4-1 2019-03-18 [1] CRAN (R 3.6.1)
crayon 1.3.4 2017-09-16 [1] CRAN (R 3.6.2)
desc 1.2.0 2018-05-01 [1] CRAN (R 3.6.2)
devtools 2.3.0 2020-04-10 [1] CRAN (R 3.6.3)
dichromat * 2.0-0 2013-01-24 [1] CRAN (R 3.6.0)
digest 0.6.25 2020-02-23 [1] CRAN (R 3.6.3)
dplyr * 0.8.5 2020-03-07 [1] CRAN (R 3.6.3)
DT 0.13 2020-03-23 [1] CRAN (R 3.6.3)
ellipsis 0.3.0 2019-09-20 [1] CRAN (R 3.6.2)
evaluate 0.14 2019-05-28 [1] CRAN (R 3.6.2)
fansi 0.4.1 2020-01-08 [1] CRAN (R 3.6.2)
fs 1.3.1 2019-05-06 [1] CRAN (R 3.6.2)
gdata 2.18.0 2017-06-06 [1] CRAN (R 3.6.2)
ggplot2 * 3.2.1 2019-08-10 [1] CRAN (R 3.6.2)
ggpubr * 0.2.5 2020-02-13 [1] CRAN (R 3.6.2)
ggsignif 0.6.0 2019-08-08 [1] CRAN (R 3.6.2)
glue 1.4.0 2020-04-03 [1] CRAN (R 3.6.3)
gtable 0.3.0 2019-03-25 [1] CRAN (R 3.6.2)
gtools 3.8.2 2020-03-31 [1] CRAN (R 3.6.2)
highr 0.8 2019-03-20 [1] CRAN (R 3.6.2)
hms 0.5.3 2020-01-08 [1] CRAN (R 3.6.2)
htmltools 0.4.0 2019-10-04 [1] CRAN (R 3.6.2)
htmlwidgets 1.5.1 2019-10-08 [1] CRAN (R 3.6.2)
httr 1.4.1 2019-08-05 [1] CRAN (R 3.6.2)
kableExtra * 1.1.0 2019-03-16 [1] CRAN (R 3.6.3)
knitr * 1.28 2020-02-06 [1] CRAN (R 3.6.2)
lazyeval 0.2.2 2019-03-15 [1] CRAN (R 3.6.2)
lifecycle 0.2.0 2020-03-06 [1] CRAN (R 3.6.3)
magrittr * 1.5 2014-11-22 [1] CRAN (R 3.6.2)
memoise 1.1.0 2017-04-21 [1] CRAN (R 3.6.2)
munsell 0.5.0 2018-06-12 [1] CRAN (R 3.6.2)
pillar 1.4.3 2019-12-20 [1] CRAN (R 3.6.2)
pkgbuild 1.0.6 2019-10-09 [1] CRAN (R 3.6.2)
pkgconfig 2.0.3 2019-09-22 [1] CRAN (R 3.6.2)
pkgload 1.0.2 2018-10-29 [1] CRAN (R 3.6.2)
prettyunits 1.1.1 2020-01-24 [1] CRAN (R 3.6.2)
processx 3.4.2 2020-02-09 [1] CRAN (R 3.6.2)
ps 1.3.2 2020-02-13 [1] CRAN (R 3.6.2)
purrr 0.3.4 2020-04-17 [1] CRAN (R 3.6.3)
R6 2.4.1 2019-11-12 [1] CRAN (R 3.6.2)
RColorBrewer * 1.1-2 2014-12-07 [1] CRAN (R 3.6.0)
Rcpp 1.0.4.6 2020-04-09 [1] CRAN (R 3.6.3)
readr 1.3.1 2018-12-21 [1] CRAN (R 3.6.2)
remotes 2.1.1 2020-02-15 [1] CRAN (R 3.6.2)
rlang 0.4.5 2020-03-01 [1] CRAN (R 3.6.3)
rmarkdown * 2.1 2020-01-20 [1] CRAN (R 3.6.2)
rprojroot 1.3-2 2018-01-03 [1] CRAN (R 3.6.2)
rstudioapi 0.11 2020-02-07 [1] CRAN (R 3.6.2)
rvest 0.3.5 2019-11-08 [1] CRAN (R 3.6.2)
scales 1.1.0 2019-11-18 [1] CRAN (R 3.6.2)
sessioninfo 1.1.1 2018-11-05 [1] CRAN (R 3.6.2)
stringi 1.4.6 2020-02-17 [1] CRAN (R 3.6.2)
stringr 1.4.0 2019-02-10 [1] CRAN (R 3.6.2)
testthat 2.3.2 2020-03-02 [1] CRAN (R 3.6.3)
tibble 3.0.1 2020-04-20 [1] CRAN (R 3.6.3)
tidyselect 1.0.0 2020-01-27 [1] CRAN (R 3.6.2)
usethis 1.6.0 2020-04-09 [1] CRAN (R 3.6.3)
vctrs 0.2.4 2020-03-10 [1] CRAN (R 3.6.3)
viridisLite 0.3.0 2018-02-01 [1] CRAN (R 3.6.2)
webshot 0.5.2 2019-11-22 [1] CRAN (R 3.6.3)
withr 2.1.2 2018-03-15 [1] CRAN (R 3.6.2)
xfun 0.12 2020-01-13 [1] CRAN (R 3.6.2)
xml2 1.2.2 2019-08-09 [1] CRAN (R 3.6.2)
yaml 2.2.1 2020-02-01 [1] CRAN (R 3.6.2)
[1] C:/Users/an499583/Documents/R/win-library/3.6
[2] C:/Users/an499583/Documents/R/R-3.6.3/library